home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 6 / 64er_Magazin_Sonderheft_06_86-06_1986_Markt__Technik_de_Disk_2_of_3_Side_A.d64 / listing 3 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  24KB  |  921 lines
  1. 1 rem  **********************************
  2. 2 rem *    giga-cad  graphic-system    *
  3. 3 rem *          'cad.create'          *
  4. 4 rem * by s. vilsmeier & s. lippstreu *
  5. 5 rem **********************************
  6. 6 :
  7. 7 :
  8. 8 a=peek(836)+1:poke836,a:ifa=1thenpoke55,0:poke56,82:clr:a=1
  9. 9 ifa=1thenload"hires3.cad.obj",8,1
  10. 10 ifa=2thenload"hires8.cad.obj",8,1
  11. 11 open1,8,15:gosub688
  12. 12 sys50707,1:poke53280,14:dimp(30,2),b$(63)
  13. 13 ifd=0thengosub907
  14. 14 :
  15. 15 :
  16. 16 rem **********************************
  17. 17 rem *    variablen/ sys-aressen      *
  18. 18 rem **********************************
  19. 19 :
  20. 20 h=50181:co=50292:pl=50447:e=50707:g=50859:li=51049:jo=51627:rf=53280
  21. 21 fl=51480:l=51507:r=51800:kr=52008:d4=52103:d3=52176:t1=52466:t2=52490
  22. 22 mu=52517:cp=36878:l3=38378:j2=39247:c1=39718:d1=40052:c2=40206
  23. 23 d2=40344:l4=21764:ci=21836:um=22873:c3=25652:da=25123
  24. 24 sysh,11,15,2:goto108
  25. 25 :
  26. 26 :
  27. 27 rem *********************************
  28. 28 rem *    grafik loeschen/ menue     *
  29. 29 rem *********************************
  30. 30 :
  31. 31 print"[147][151]";:sysh,11,15,b:syst1,b
  32. 32 bs=b:gosub68:syskr,1,b:sysmu,b:ifp=1thengosub61
  33. 33 return
  34. 34 j=j-128:qx=o:o=pz:gosub122:pz=o:o=qx:return:rem joyst. umwandlung -tiefe
  35. 35 :
  36. 36 :
  37. 37 rem *********************************
  38. 38 rem *     diverse unterprogramme    *
  39. 39 rem *********************************
  40. 40 :
  41. 41 print"[147][151] [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]":return
  42. 42 fori=1to22:print" [180]                                    [170]":next
  43. 43 print" [183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]":return
  44. 44 n$="":input"[205]akro - [206]ame     ";n$
  45. 45 iflen(n$)>13thenprint"[145][145][145][145]";:goto44
  46. 46 gosub79:return
  47. 47 geta$:ifa$=""goto47
  48. 48 return
  49. 49 n1=0:fori=1tok:ifn$=b$(i)thenn1=i:i=k
  50. 50 next:return
  51. 51 print"  [196]ieses [205]akro ist nicht im [211]peicher !":gosub47:return
  52. 52 n$="":print"[213]nter welchem [206]amen soll das [205]akro"
  53. 53 input"eingefuegt werden                  [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";n$
  54. 54 gosub79:return
  55. 55 printchr$(14)chr$(8):poke198,0:return
  56. 56 bs=1
  57. 57 sysg,240,0,293,9,2,bs:return
  58. 58 bs=2:goto57
  59. 59 bs=1
  60. 60 sysg,139,0,180,9,2,bs:return
  61. 61 bs=2:goto60
  62. 62 sysg,0,0,42,9,2,1:return
  63. 63 sysg,99,0,137,9,2,1:return
  64. 64 sysg,43,0,98,9,2,1:return
  65. 65 sysh,11,15,2:return
  66. 66 bs=2:goto68
  67. 67 bs=1
  68. 68 sysr,0,0,319,199,1,bs:syscp,bs:return
  69. 69 zm=1:goto71
  70. 70 zm=0
  71. 71 sysr,2,101,157,197,zm,3:return
  72. 72 sysj2,z,o,0
  73. 73 z=peek(2024)+256*peek(2025):o=peek(2026):a=peek(631):return
  74. 74 xa=usr(1):sa=usr(2):vb=usr(3):return
  75. 75 ei=peek(877):c=peek(881):ifeithenei=0:c=0:wq=1
  76. 76 return
  77. 77 sysjo:j=peek(859):geta$:return
  78. 78 x2=x1:y2=y1:z2=z1:return
  79. 79 n1=0:ifn$="_"orn$=""thenn1=1
  80. 80 return
  81. 81 ifpeek(53272)<>23thensyse,0:gosub55
  82. 82 a=0:geta$:ifa$<>""thena=asc(a$)
  83. 83 return
  84. 84 input"[214]erbindungsvorschrift ";vb:ifvb<0orvb>2thenprint"[145][145][145][145]";:goto84
  85. 85 syse,1:return
  86. 86 :
  87. 87 :
  88. 88 rem *********************************
  89. 89 rem *   flaechen & makros durchbl.  *
  90. 90 rem *********************************
  91. 91 :
  92. 92 syse,1
  93. 93 iff<1thenf=n1
  94. 94 iff=n1+1thenf=1
  95. 95 sysl,1:gosub65:sysda,mo,f,1,2
  96. 96 sysco,2,2:sysfl,4
  97. 97 gosub47
  98. 98 a=asc(a$):ifa=43thenf=f+1:goto93
  99. 99 ifa=86thengosub887:return
  100. 100 ifa=45thenf=f-1:goto93
  101. 101 return
  102. 102 :
  103. 103 :
  104. 104 rem *********************************
  105. 105 rem *      1. darstellung           *
  106. 106 rem *********************************
  107. 107 :
  108. 108 b=2:gosub31:ifd=1thensys25919
  109. 109 ifpthensysda,5,k,1,b:goto111
  110. 110 zn=0:sysda,zn,dg,1,b
  111. 111 sysco,1,0
  112. 112 :
  113. 113 :
  114. 114 rem *********************************
  115. 115 rem *  joystick-abfrage hauptmenue  *
  116. 116 rem *********************************
  117. 117 :
  118. 118 z=159:o=12:poke40783,0
  119. 119 gosub72
  120. 120 ifpeek(631)=0then127
  121. 121 goto119
  122. 122 w=w+1:ifw>20thenw=20
  123. 123 ifj1<>jthenw=1
  124. 124 ifme=2thenw=w*2
  125. 125 o=o-((j>3andj<7)-(j<3orj>7))*w:z=z-((j>1andj<5)-(j>5))*w:ifme=2thenw=w/2
  126. 126 n=0:j1=j:return
  127. 127 ifo>9goto119
  128. 128 ifz<42goto182
  129. 129 ifz>182andz<239goto344
  130. 130 ifz>99andz<137andd<>1goto420
  131. 131 ifz>43andz<98goto455
  132. 132 ifz>137andz<182goto555
  133. 133 ifz>239andz<293andp=0goto784
  134. 134 ifz>292andp=0thenprint"[147]":syse,0:goto898
  135. 135 goto119
  136. 136 :
  137. 137 :
  138. 138 rem *********************************
  139. 139 rem *        linien-blinken         *
  140. 140 rem *********************************
  141. 141 :
  142. 142 ifn=0thenreturn
  143. 143 sysl4,pa,pb,z,o,2,b
  144. 144 ifu=1orme=3thenn=1-n:return
  145. 145 sysl4,z,o,pc,pd,2,b:n=1-n:return
  146. 146 :
  147. 147 :
  148. 148 rem *********************************
  149. 149 rem *   tastaturabfrage (blinken)   *
  150. 150 rem *********************************
  151. 151 :
  152. 152 a=asc(a$)
  153. 153 n=1-n:gosub142:n=1-n:ifme=3goto159
  154. 154 ifa=147thengosub65:poke40783,0:b=2:goto183
  155. 155 ifa=76thengosub142:gosub170:ifu=0goto189
  156. 156 ifa=95goto213
  157. 157 ifa=67thensysci,b:n=1
  158. 158 goto198
  159. 159 ifa=147thensyse,2:poke40783,0:goto456
  160. 160 ifa=76thengosub142:gosub173:ifu=0goto459
  161. 161 ifa=95goto483
  162. 162 ifa=67thensysci,b:n=1
  163. 163 goto468
  164. 164 :
  165. 165 :
  166. 166 rem *********************************
  167. 167 rem *        linie loeschen         *
  168. 168 rem *********************************
  169. 169 :
  170. 170 gosub142:u=u-1:ifu=0thenreturn
  171. 171 sysl4,p(u-1,1)+160,p(u-1,2)+100,pc,pd,2,b
  172. 172 pc=p(u-1,1)+160:pd=p(u-1,2)+100:z=pc:o=pd:return
  173. 173 u=u-1:ifu=0thenreturn
  174. 174 sysl4,p(u-1,0)+160,180-p(u-1,1),pa,pb,2,2
  175. 175 z=pa:o=pb:pa=p(u-1,0)+160:pb=180-p(u-1,1):return
  176. 176 :
  177. 177 :
  178. 178 rem *********************************
  179. 179 rem *      flaeche: 2d-eingabe      *
  180. 180 rem *********************************
  181. 181 :
  182. 182 gosub65:me=1:b=3:c=0
  183. 183 gosub66:syst1,2:sysd4,1,2
  184. 184 u=0:sysg,0,0,42,9,2,b
  185. 185 ifpthengosub61
  186. 186 m=0:b=2
  187. 187 sysli,160,97,160,103,1,2
  188. 188 sysli,157,100,163,100,1,2:syse,2
  189. 189 z=160:o=100
  190. 190 gosub72
  191. 191 ifa<>0goto193
  192. 192 goto197
  193. 193 ifa=67thensysci,b
  194. 194 ifa=95goto213
  195. 195 goto190
  196. 196 rem ***** 1. eckpunkt ************
  197. 197 n=0:u=1:p(0,1)=z-160:p(0,0)=0:p(0,2)=o-100:pa=z:pb=o:pc=z:pd=o
  198. 198 gosub143:gosub77:ifa$<>""goto152
  199. 199 ifj=0thenw=0:goto198
  200. 200 gosub142:ifj=128then202
  201. 201 gosub122:goto198
  202. 202 ifpc=zandpd=ogoto198
  203. 203 ifu>29goto198
  204. 204 sysl4,pc,pd,z,o,2,2
  205. 205 u=u+1:pc=z:pd=o:p(u-1,1)=pc-160:p(u-1,0)=0:p(u-1,2)=pd-100
  206. 206 goto198
  207. 207 :
  208. 208 :
  209. 209 rem ********************************
  210. 210 rem *     flaeche: einfuegen (3d)   *
  211. 211 rem ********************************
  212. 212 :
  213. 213 vf=0:ifu>1thengosub321:dg=d-1
  214. 214 c=0:me=1:sysl,1:m=0:z=160:o=100
  215. 215 gosub65:ifu<2thenme=0:gosub62:goto118
  216. 216 sysda,1,dg,1,2
  217. 217 sysco,2,2:sysfl,4
  218. 218 ifc=0thengosub69
  219. 219 ifc<>0then223
  220. 220 b=2:gosub72:ifa<>0goto227
  221. 221 ifz<42ando<9thena=95:goto227
  222. 222 wq=1
  223. 223 gosub749:ifc=0then220
  224. 224 gosub762:ifc=0then220
  225. 225 sysum,c,1,dg,d,ei,j,w:gosub75
  226. 226 sysl,1:m=0:goto215
  227. 227 gosub769:syse,1:ifsvgoto225
  228. 228 ifa=95goto325
  229. 229 ifa=48thenc=10:gosub772:df=dg:c=1:gosub548:goto225
  230. 230 ifa=43thenvf=dg:goto240
  231. 231 ifa=76thengosub254:goto325
  232. 232 ifa=42andvf<>0goto304
  233. 233 goto220
  234. 234 :
  235. 235 :
  236. 236 rem ********************************
  237. 237 rem *     flaeche duplizieren      *
  238. 238 rem ********************************
  239. 239 :
  240. 240 sysl,1:sysco,1,1:s=0
  241. 241 sysd2,dg:gosub74:ifs<>2thenze=1:gosub915:iffthensyse,1:goto247
  242. 242 sysd2,dg+1:xb=usr(1):ifs=2thensa=k
  243. 243 sysc2,v+1,d,sa,vb:d=d+1:sysc2,v+(xb-xa)+1,d,sa,vb
  244. 244 fori=xatoxb-1:v=v+1
  245. 245 sysd1,i:sysc1,usr(1),usr(2),usr(3),v
  246. 246 next:ifs=2thenreturn
  247. 247 dg=d-1:goto214
  248. 248 :
  249. 249 :
  250. 250 rem ********************************
  251. 251 rem *    flaeche loeschen          *
  252. 252 rem ********************************
  253. 253 :
  254. 254 sysl,1
  255. 255 sysd2,dg:ya=usr(1):sysd2,dg+1:xb=usr(1):su=xb-ya
  256. 256 fori=dg+1tod+1
  257. 257 sysd2,i:gosub74:ifxa<suthenxa=su
  258. 258 sysc2,xa-su,i-1,sa,vb:next:d=d-1
  259. 259 fori=xbtov+su
  260. 260 sysd1,i:sysc1,usr(1),usr(2),usr(3),i-su:next:v=v-su
  261. 261 return
  262. 262 :
  263. 263 :
  264. 264 rem ********************************
  265. 265 rem *    makro loeschen            *
  266. 266 rem ********************************
  267. 267 :
  268. 268 x2=1:y2=0:sysl,1:b$(dg)=""
  269. 269 fori=1tod-1
  270. 270 sysd2,i:gosub74:ifsa=dggoto280
  271. 271 ifsa>dgthensa=sa-1
  272. 272 sysd2,i+1:z1=usr(2):xb=usr(1)
  273. 273 sysc2,y2+1,x2,sa,vb:sysc2,y2+(xb-xa)+1,x2+1,z1,vb
  274. 274 x2=x2+1
  275. 275 forq=xatoxb-1
  276. 276 sysd1,q:x1=usr(1):y1=usr(2):z1=usr(3)
  277. 277 ifx1=-3276.8thenx1=0:y1=0:z1=0
  278. 278 y2=y2+1:sysc1,x1,y1,z1,y2
  279. 279 next
  280. 280 next
  281. 281 fori=x2+1tod:sysc2,0,i,0,0:next
  282. 282 v=y2:d=x2
  283. 283 fori=dgtomm+1:b$(i)=b$(i+1):next:return
  284. 284 :
  285. 285 :
  286. 286 rem ********************************
  287. 287 rem *    makro duplizieren         *
  288. 288 rem ********************************
  289. 289 :
  290. 290 gosub890:sysl,1:sysco,1,1
  291. 291 dr=d:dh=dg
  292. 292 gosub918:gosub915:iffthenk=k-1:return
  293. 293 forx2=1todr-1
  294. 294 sysd2,x2:sa=usr(2)
  295. 295 ifsa=dhthendg=x2:gosub241
  296. 296 next
  297. 297 return
  298. 298 :
  299. 299 :
  300. 300 rem ********************************
  301. 301 rem *    flaechen verbinden        *
  302. 302 rem ********************************
  303. 303 :
  304. 304 sysl,1:sysd2,vf:xa=usr(1):vb=usr(3):sysd2,vf+1:xb=usr(1):sysd2,dg:ya=usr(1)
  305. 305 ze=4*(xb-xa):gosub915:iffgoto314
  306. 306 fori=xatoxb:ifi=xbthenx1=x3:y1=y3:z1=z3:pa=x4:pb=y4:pc=z4:goto310
  307. 307 sysd1,i:x1=usr(1):y1=usr(2):z1=usr(3):sysd1,ya+(i-xa)
  308. 308 pa=usr(1):pb=usr(2):pc=usr(3)
  309. 309 ifi=xathenx3=x1:y3=y1:z3=z1:x4=pa:y4=pb:z4=pc:goto313
  310. 310 sysc2,v+1,d,mm,vb:d=d+1:sysc2,v+5,d,mm,vb
  311. 311 v=v+1:sysc1,x1,y1,z1,v:v=v+1:sysc1,x2,y2,z2,v
  312. 312 v=v+1:sysc1,pd,pe,pf,v:v=v+1:sysc1,pa,pb,pc,v:sysda,1,d-1,1,1
  313. 313 gosub78:pd=pa:pe=pb:pf=pc:next
  314. 314 gosub65:sysda,1,dg,1,2:sysco,2,2:sysfl,4:goto220
  315. 315 :
  316. 316 :
  317. 317 rem ********************************
  318. 318 rem * flaeche in speicher codieren *
  319. 319 rem ********************************
  320. 320 :
  321. 321 ifp=0thenmm=0
  322. 322 ze=1:gosub915:iffthenreturn
  323. 323 sysc2,v+1,d,mm,vn:sysc2,v+u+1,d+1,mm,vn:d=d+1:forq=1tou
  324. 324 sysc1,p(q-1,0),p(q-1,1),p(q-1,2),q+v:next:v=v+u:return
  325. 325 gosub70:sysl,1:ifa<>76thensysco,1,1
  326. 326 me=1:ifa=43thena=0:goto215
  327. 327 me=0:gosub62:m=0:goto118
  328. 328 :
  329. 329 :
  330. 330 rem ********************************
  331. 331 rem *     symbole invertieren      *
  332. 332 rem ********************************
  333. 333 :
  334. 334 ifc<>0andei<>1thensysg,pa,pb,pc,pd,2,b
  335. 335 ifc=7thensys52664,2,b
  336. 336 ifc=8thensys52835,2,b
  337. 337 ifc=9thensys53045,2,b
  338. 338 return
  339. 339 :
  340. 340 rem ********************************
  341. 341 rem *    3d-zeichnen               *
  342. 342 rem ********************************
  343. 343 :
  344. 344 sysco,2,0:sysd3,2,2:m=1:n=0
  345. 345 sysg,182,0,239,9,2,2:me=2:syse,2
  346. 346 z=0:o=0:pz=0:n=0:b=2:u=0
  347. 347 sysli,78,55,82,55,2,2:sysli,80,53,80,57,2,2
  348. 348 sysli,238,55,242,55,2,2:sysli,240,53,240,57,2,2
  349. 349 sysli,238,145,242,145,2,2:sysli,240,143,240,147,2,2
  350. 350 ifm=0thenreturn
  351. 351 sysc3,pz,z,o,2,b:n=1-n
  352. 352 gosub77:ifa$<>""goto357
  353. 353 ifj=0orj=128thenw=0:goto351
  354. 354 ifnthensysc3,pz,z,o,2,b:n=0
  355. 355 ifj>128thengosub34:goto351
  356. 356 gosub122:goto351
  357. 357 a=asc(a$):ifnthensysc3,pz,z,o,2,b:n=0
  358. 358 ifa=94goto362
  359. 359 ifa=95thengoto413
  360. 360 ifa=67thensysci,b:n=1
  361. 361 goto351
  362. 362 u=1:p(0,1)=z:p(0,0)=pz:p(0,2)=o:pa=z:pb=o:pc=z:pd=o:pe=pz:pf=pz
  363. 363 gosub378:gosub77
  364. 364 ifa$<>""goto386
  365. 365 ifj=0orj=128thenw=0:goto363
  366. 366 gosub377:ifj>128andu<29thengosub34:goto363
  367. 367 gosub122:goto363
  368. 368 gosub377:sysl3,pf,pc,pd,pz,z,o,1,b
  369. 369 u=u+1:pc=z:pd=o:pf=pz:p(u-1,1)=pc:p(u-1,0)=pf:p(u-1,2)=pd
  370. 370 goto363
  371. 371 :
  372. 372 :
  373. 373 rem ********************************
  374. 374 rem *     3d-linien-blinken        *
  375. 375 rem ********************************
  376. 376 :
  377. 377 ifn=0thenreturn
  378. 378 sysl3,pe,pa,pb,pz,z,o,2,b:ifu=1thenn=1-n:return
  379. 379 sysl3,pf,pc,pd,pz,z,o,2,b:n=1-n:return
  380. 380 :
  381. 381 :
  382. 382 rem ********************************
  383. 383 rem *  3d-zeichnen: tastenabfrage  *
  384. 384 rem ********************************
  385. 385 :
  386. 386 a=asc(a$):ifa=87ora=94goto390
  387. 387 ifa<>147anda<>95anda<>76anda<>43anda<>70anda<>67goto363
  388. 388 ifa<>147goto390
  389. 389 poke40783,0:sysco,2,0:sysd3,2,2:goto345
  390. 390 ifa=95goto396
  391. 391 ifa=76goto405
  392. 392 ifa=43thenm=0:gosub347:m=1:goto397
  393. 393 n=1-n:gosub377:n=1-n:ifa=67thensysci,b:goto363
  394. 394 ifa=94goto368
  395. 395 gosub62:goto213
  396. 396 ifu<2goto413
  397. 397 me=2:gosub321:syse,2
  398. 398 m=0:forq=0tou-1:ifq=uthenx1=x3:y1=y3:z1=z3:goto400
  399. 399 x1=p(q,0):y1=p(q,1):z1=p(q,2):ifm=0thenm=1:x3=x1:y3=y1:z3=z1:goto401
  400. 400 sysl3,x1,y1,z1,x2,y2,z2,1,3
  401. 401 gosub78:next
  402. 402 sysl3,pe,pa,pb,pf,pc,pd,1,3
  403. 403 ifa=43thenn=1:u=0:b=2:goto346
  404. 404 n=0:syse,1:me=0:goto118
  405. 405 gosub377:ifu=<1thenz=0:o=0:pz=0:u=0:goto344
  406. 406 sysco,2,0:u=u-2:sysg,182,0,239,9,2,2:sysd3,2,2
  407. 407 m=0:forq=0tou
  408. 408 x1=p(q,0):y1=p(q,1):z1=p(q,2):ifm=0thengosub347:m=1:goto410
  409. 409 sysl3,x1,y1,z1,x2,y2,z2,1,2
  410. 410 gosub78:next
  411. 411 pc=p(u,1):pd=p(u,2):pf=p(u,0):z=pc:o=pd:pz=pf:u=u+1
  412. 412 goto363
  413. 413 ifu<2thenme=0:syse,1:n=0:goto118
  414. 414 :
  415. 415 :
  416. 416 rem ********************************
  417. 417 rem *     form                     *
  418. 418 rem ********************************
  419. 419 :
  420. 420 gosub63:gosub69:sysco,2,0:me=0
  421. 421 z=160:o=100:fo=1:jl=0:c=0
  422. 422 syse,1:b=1
  423. 423 zn=0:ifpthendg=mm:zn=5
  424. 424 gosub72
  425. 425 ifa<>0goto435
  426. 426 ifz>99andz<137ando<9thena=95:goto435
  427. 427 wq=1
  428. 428 gosub749:ifc=0goto424
  429. 429 gosub762:ifc=0goto424
  430. 430 gosub70:sysum,c,zn,dg,d,ei,j,w:gosub75
  431. 431 ifjl=0thengosub442:gosub334:syse,1:sysco,2,0
  432. 432 ifjl>0thenjl=jl+1
  433. 433 gosub69:ifc=0goto424
  434. 434 goto428
  435. 435 gosub769:sysl,1:syse,1:ifsvgoto430
  436. 436 gosub446:ifjl>1anda=133thenpokerf,14:gosub442:syse,1:sysco,2,0:jl=0
  437. 437 ifa=95andjl>1thenpokerf,14:gosub442:syse,1:sysco,2,0:jl=0
  438. 438 ifa=95thengosub63:gosub70:me=0:fo=0:goto118
  439. 439 ifa=48thenc=10:gosub772:df=dg:c=zn:gosub548:goto430
  440. 440 goto424
  441. 441 rem *** neue gesamtdarstellung **
  442. 442 syse,2:b=1:gosub31
  443. 443 gosub67:gosub63
  444. 444 ifp=1thengosub59
  445. 445 sysda,zn,dg,1,b:gosub75:gosub69:return
  446. 446 ifa=133andjl=0thenjl=1:pokerf,6:return
  447. 447 ifa=133andjl=1thenjl=0:pokerf,14
  448. 448 return
  449. 449 :
  450. 450 :
  451. 451 rem ********************************
  452. 452 rem *     rotation: 2d-eingabe     *
  453. 453 rem ********************************
  454. 454 :
  455. 455 u=0:gosub64:me=3
  456. 456 gosub65:syst1,2:gosub66:sysg,43,0,98,9,2,2
  457. 457 sysd4,2,2:sys22659,1,2:syse,2
  458. 458 ifpthengosub61
  459. 459 z=160:o=170:b=2
  460. 460 sysj2,z,o,1:gosub73
  461. 461 ifa<>0goto463
  462. 462 goto467
  463. 463 ifa=95thensyse,1:gosub64:me=0:goto118
  464. 464 ifa=67thensysci,b
  465. 465 ifa=147thensyse,2:poke40783,0:goto456
  466. 466 goto460
  467. 467 n=0:u=1:p(0,0)=z-160:p(0,1)=180-o:pa=z:pb=o
  468. 468 gosub143:gosub77:ifa$<>""goto152
  469. 469 ifj=0thenw=0:goto468
  470. 470 gosub142:ifj=128andu<29thengosub473:goto468
  471. 471 gosub122:ifo>180theno=180
  472. 472 goto468
  473. 473 ifpa=zandpb=othenreturn
  474. 474 ifu>48thenreturn
  475. 475 sysli,z,o,pa,pb,2,2
  476. 476 pa=z:pb=o:p(u,0)=z-160:p(u,1)=180-o:u=u+1:return
  477. 477 :
  478. 478 :
  479. 479 rem ********************************
  480. 480 rem *    rotation: einfuegen (3d)  *
  481. 481 rem ********************************
  482. 482 :
  483. 483 syse,0:gosub55:k=k+1
  484. 484 gosub41:gosub43:print"       [210]otationskoerper erstellen      [146] "
  485. 485 fc=0:input"[193]nzahl der [198]acetten   ";fc
  486. 486 iffc<3thenprint"[145][145]";:goto485
  487. 487 input"[210]otationswinkel         360[157][157][157][157][157]";rw
  488. 488 ifabs(rw)>360thenprint"[145][145]";:goto487
  489. 489 input"[214]erbindungsvorschrift   0[157][157][157]";vb
  490. 490 ifvb<0orvb>3thenprint"[145][145]";:goto489
  491. 491 ifp<>0goto498
  492. 492 ifs=2thensyse,0:gosub55:print"[147]";
  493. 493 n$="":input"[205]akro - [206]ame          ";n$
  494. 494 if(n$="_"orn$="")ands=2thenprint"[145][145]";:goto493
  495. 495 gosub79:ifn1thenk=k-1:a=95:goto463
  496. 496 gosub49:ifn1thenprint"[145][145]";:goto493
  497. 497 b$(k)=n$
  498. 498 syse,1:w=rw*(NULL)/180:ifs=2thens=0:goto515
  499. 499 ze=4*(u-1)*fc:gosub915:iffthenb$(k)="":goto484
  500. 500 gosub890:z=0:fori=0tow-.000001stepw/fc:w=w/fc:w1=sin(i):w2=cos(i):pc=sin(i+w)
  501. 501 pd=cos(i+w):forq=0tou-2
  502. 502 sysc2,v+1,d,k,vb:sysc2,v+5,d+1,k,vb:d=d+1:v=v+1
  503. 503 sysc1,w1*p(q,1),w2*p(q,1),p(q,0),v:v=v+1
  504. 504 sysc1,pc*p(q,1),pd*p(q,1),p(q,0),v:v=v+1
  505. 505 sysc1,pc*p(q+1,1),pd*p(q+1,1),p(q+1,0),v:v=v+1
  506. 506 sysc1,w1*p(q+1,1),w2*p(q+1,1),p(q+1,0),v
  507. 507 next:w=w*fc
  508. 508 next:dg=k
  509. 509 :
  510. 510 :
  511. 511 rem ********************************
  512. 512 rem *      makros einfuegen        *
  513. 513 rem ********************************
  514. 514 :
  515. 515 z=159:o=100:jl=0:c=0
  516. 516 ifjl=0thengosub539
  517. 517 ifjl>0thenjl=jl+1:sysfl,4:gosub69
  518. 518 ifc<>0goto524
  519. 519 gosub72
  520. 520 ifa<>0goto528
  521. 521 ifz>43andz<98ando<9andas=0thena=95:goto528
  522. 522 ifz>137andz<182ando<9andasthena=95:goto528
  523. 523 wq=1
  524. 524 gosub749:ifc=0goto519
  525. 525 gosub762:ifc=0goto519
  526. 526 sysl,1
  527. 527 gosub70:sysum,c,3,dg,d,ei,j,w:gosub75:goto516
  528. 528 if(a=95ora=43)andjl>1thenpokerf,14:sysl,1:gosub539:jl=0
  529. 529 ifa=76andjl>0thenpokerf,14:jl=0
  530. 530 ifa=95thensysl,1:sysco,1,1:goto543
  531. 531 gosub446:ifa=133andjl>1thenpokerf,14:jl=0:sysl,1:gosub539
  532. 532 ifa=76thengosub268:me=1:k=k-1:goto543
  533. 533 ifa=43thenk=k+1:s=2:gosub290:syse,1:iffthena=95:goto528
  534. 534 ifa=43thendg=k:goto492
  535. 535 ifa=48thenc=10:gosub772:df=k:c=3:gosub548:goto527
  536. 536 gosub769:syse,1:ifsvgoto526
  537. 537 goto519
  538. 538 rem *** neu darstellen **********
  539. 539 gosub65:b=2
  540. 540 sysda,3,dg,1,b
  541. 541 sysco,2,2:gosub69:fo=2
  542. 542 sysfl,4:return
  543. 543 gosub70:fo=0:c=0:ei=0:ifas=0thengosub64
  544. 544 ifpandasthenas=0:return
  545. 545 ifas<>0thenas=0:gosub59
  546. 546 me=0:goto118
  547. 547 rem *** '0' bei umformungen *****
  548. 548 gosub70:sysum,1,c,df,d,1,0,w:sysum,2,c,df,d,1,0,w:ei=1:c=3:syse,1:return
  549. 549 :
  550. 550 :
  551. 551 rem ********************************
  552. 552 rem *     makro - hauptmenue       *
  553. 553 rem ********************************
  554. 554 :
  555. 555 gosub41
  556. 556 print"            [205][193][203][210][207] -[200]auptmenue          [146]"
  557. 557 gosub42
  558. 558 print"[193].[205]akro laden"
  559. 559 print"[194].[205]akro speichern"
  560. 560 print"[195].[196]iskettenkommando senden"
  561. 561 print"[196].[205]akros auf [196]iskette"
  562. 562 print"[197].[205]akros im [211]peicher"
  563. 563 print"[198].[205]akro erstellen"
  564. 564 print"[199].[205]akro einfuegen"
  565. 565 print"[200].[193]lles [197]rstellte als [205]akro"
  566. 566 gosub81:if(a<65ora>72)anda<>95goto566
  567. 567 ifa=95thensyse,1:open1,8,15,"u9":close1:goto118
  568. 568 ona-64goto664,644,695,706,625,575,588,614
  569. 569 :
  570. 570 :
  571. 571 rem ********************************
  572. 572 rem *     makro erstellen          *
  573. 573 rem ********************************
  574. 574 :
  575. 575 ifp=1goto566
  576. 576 gosub41:gosub43
  577. 577 print"            [205]akro erstellen            [146] "
  578. 578 gosub890:gosub44:ifn1goto555
  579. 579 gosub49:ifn1thenprint"[145][145][145][145][145]";:goto578
  580. 580 b$(k+1)=n$
  581. 581 p=1:k=k+1:mm=k:syse,1:zw=d:goto108
  582. 582 :
  583. 583 :
  584. 584 rem ********************************
  585. 585 rem *     makro einfuegen          *
  586. 586 rem ********************************
  587. 587 :
  588. 588 ifk=0goto566
  589. 589 gosub41:gosub43:print"            [205]akro einfuegen            [146]"
  590. 590 gosub44:ifn1goto555
  591. 591 ifn$<>b$(mm)goto598
  592. 592 ifd=zwthenas=1:p=0:sysda,0,v,1,1:syse,1:k=k-1:goto543
  593. 593 fori=1tod:sysd2,i:sa=usr(2):ifsa>mmthensysc2,usr(1),i,mm,usr(3)
  594. 594 next
  595. 595 zn=4:dg=mm:sysh,11,15,1:syst1,1:gosub67:sysmu,1:syskr,1,1
  596. 596 as=1:gosub59:sysda,zn,dg,1,1
  597. 597 syse,1:p=0:k=mm:mm=0:dg=k:goto515
  598. 598 gosub49:ifn1goto600
  599. 599 gosub51:goto555
  600. 600 dg=n1:i=1:k=k+1:ifp=1then605
  601. 601 gosub52:ifn1thenk=k-1:goto555
  602. 602 gosub49:ifn1thenprint"[145][145][145][145][145]";:goto601
  603. 603 b$(k)=n$:i=1
  604. 604 gosub918:gosub915:iffthenk=k-1:goto555
  605. 605 s=2:gosub291:as=1:zn=4:dg=k:gosub65:b=1:ifpgoto607
  606. 606 gosub59:gosub515:as=0:gosub59:goto118
  607. 607 gosub515:as=0:goto118
  608. 608 :
  609. 609 :
  610. 610 rem ********************************
  611. 611 rem *  alles erstellte als makro   *
  612. 612 rem ********************************
  613. 613 :
  614. 614 ifd=1orpgoto566
  615. 615 gosub41:gosub43:print"       [193]lles [197]rstellte als [205]akro       [146] "
  616. 616 gosub44:ifn1goto555
  617. 617 b$(1)=n$:fori=1tod:sysd2,i:q=usr(1):vb=usr(3):sysc2,q,i,1,vb:next
  618. 618 k=1:syse,1:goto118
  619. 619 :
  620. 620 :
  621. 621 rem ********************************
  622. 622 rem *     makros im speicher       *
  623. 623 rem ********************************
  624. 624 :
  625. 625 za=0:a=1:e1=19:mr=k:ifp=1thenmr=mm
  626. 626 ifmr=0goto566
  627. 627 gosub41
  628. 628 print"           [205]akros im [211]peicher          [146] ";:ife1>mrthene1=mr
  629. 629 gosub42:n1$=str$(1322-v):n1$=right$("0000"+right$(n1$,len(n1$)-1),4)
  630. 630 print"":fori=zato18:print"                   ":next
  631. 631 print"":forx=atoe1
  632. 632 print"          ";left$(b$(x)+"..............",14):next
  633. 633 ife1=mrthenprint"     "n1$" [197]ckpunkte frei"
  634. 634 gosub47
  635. 635 ife1=mrgoto555
  636. 636 a=e1+1:e1=a+18:ife1>mrthene1=mr:ifa>mrthena=mr-1
  637. 637 goto630
  638. 638 :
  639. 639 :
  640. 640 rem ********************************
  641. 641 rem *     makro speichern          *
  642. 642 rem ********************************
  643. 643 :
  644. 644 ifk=0goto566
  645. 645 gosub41
  646. 646 print"             [205]akro speichern           [146] "
  647. 647 gosub44:ifn1goto555
  648. 648 gosub49:ifn1goto650
  649. 649 print"[145]":gosub51:goto555
  650. 650 n2=n1:print:print""n$"[145]"
  651. 651 n$="":input"[198]ile  - [206]ame     ";n$:gosub79:ifn1goto555
  652. 652 iflen(n$)>13thenprint"[145]";:goto651
  653. 653 gosub918:open2,8,2,"ma."+n$+",s,w":gosub684:iff<>0goto555
  654. 654 print#2,ze:ifstgoto656
  655. 655 print#2,n$:sys21301,d,n2
  656. 656 close2:close1:gosub684:iff=0thengosub688
  657. 657 goto555
  658. 658 :
  659. 659 :
  660. 660 rem ********************************
  661. 661 rem *      makro laden             *
  662. 662 rem ********************************
  663. 663 :
  664. 664 gosub41:gosub43
  665. 665 print"               [205]akro laden             [146] "
  666. 666 gosub890:n$="":input"[198]ile - [206]ame     ";n$:gosub79:ifn1goto555
  667. 667 iflen(n$)>13thenprint"[145][145][145][145]";:goto666
  668. 668 open2,8,2,"ma."+n$+",s,r":gosub684:iff<>0goto555
  669. 669 input#2,ze:ifstgoto674
  670. 670 gosub915:iffthenclose2:close1:goto555
  671. 671 input#2,n$:ifstgoto674
  672. 672 k=k+1:ifp=0thenb$(k)=n$
  673. 673 sys21006,d,v,k
  674. 674 close2:close1:gosub684:iff=0goto676
  675. 675 k=k-1:goto555
  676. 676 gosub688:d=peek(2026)+256*peek(2027):v=peek(2028)+256*peek(2029)
  677. 677 goto735
  678. 678 :
  679. 679 :
  680. 680 rem ********************************
  681. 681 rem *     disk - status            *
  682. 682 rem ********************************
  683. 683 :
  684. 684 open1,8,15:input#1,f,f$,t,s:iff=0thenreturn
  685. 685 print:print"[196]iskettenfehler :"
  686. 686 print""f","f$","t","s
  687. 687 gosub47
  688. 688 close2:print#1,"u9":close1:return
  689. 689 :
  690. 690 :
  691. 691 rem ********************************
  692. 692 rem *     diskettenkommando senden *
  693. 693 rem ********************************
  694. 694 :
  695. 695 gosub41:gosub43
  696. 696 print"        [196]iskettenkommando senden       [146] "
  697. 697 poke631,34:poke198,1:n$="":input"[203]ommando ";n$:gosub79:ifn1goto555
  698. 698 open1,8,15,n$:input#1,f,f$,t,s:print"[196]iskettenstatus :"
  699. 699 gosub686:goto555
  700. 700 :
  701. 701 :
  702. 702 rem ********************************
  703. 703 rem *     makros auf diskette      *
  704. 704 rem ********************************
  705. 705 :
  706. 706 gosub41
  707. 707 print"          [205]akros auf [196]iskette          [146] ";
  708. 708 print:open2,8,0,"$0:ma.*=seq":sys26134:close2
  709. 709 gosub684:close2:close1:iff=0thengosub47
  710. 710 goto555
  711. 711 :
  712. 712 :
  713. 713 rem ********************************
  714. 714 rem *      parameter-uebergabe     *
  715. 715 rem ********************************
  716. 716 :
  717. 717 w2=int(w/256):w1=w-256*w2:pokea+i,w1:pokea+i+1,w2:i=i+2:return
  718. 718 pokerf,15
  719. 719 printchr$(14)chr$(8)"[147][151]        [211]ystemdiskette einlegen !"
  720. 720 gosub47:ifa$="_"thenreturn
  721. 721 open2,8,2,"cad.main,p,r":close2:gosub684:iffthena$="_":return
  722. 722 print#1,"u9":close1:return
  723. 723 forx=1tok:fory=1to13:w=peek(a+y):ifw=254theny=13:goto725
  724. 724 b$(x)=b$(x)+chr$(w)
  725. 725 nexty:a=a+14:nextx:a=49153:return
  726. 726 ifk=0thenreturn
  727. 727 forx=1tok:fory=1tolen(b$(x)):pokea+y,asc(mid$(b$(x),y,1)):nexty
  728. 728 pokea+y,254:a=a+14:nextx:a=49153:return
  729. 729 :
  730. 730 :
  731. 731 rem ********************************
  732. 732 rem *  geladenens makro einfuegen  *
  733. 733 rem ********************************
  734. 734 :
  735. 735 n$=b$(k):ifpgoto741
  736. 736 gosub49:ifn1<>kgoto738
  737. 737 goto740
  738. 738 print"":gosub52:b$(k)=n$
  739. 739 print"[145][145][145][145][145][145][145][145]";:goto736
  740. 740 i=1:dh=k:dg=k:mm=k:as=1:gosub59:goto597
  741. 741 b$(k)=""
  742. 742 i=1:dh=k:goto605
  743. 743 :
  744. 744 :
  745. 745 rem ********************************
  746. 746 rem *     angewaehltes symbol      *
  747. 747 rem ********************************
  748. 748 :
  749. 749 ifz>=159oro<=100thenc=0:return
  750. 750 ifz<50thenpa=3:pc=49:pe=1:goto753
  751. 751 ifz<100thenpa=50:pc=99:pe=3:goto753
  752. 752 pa=100:pc=156:pe=2
  753. 753 ifo<135thenpb=102:pd=134:pf=2::goto756
  754. 754 ifo<165thenpb=135:pd=164:pf=1:goto756
  755. 755 pb=165:pd=196:pf=0
  756. 756 c=pf*3+pe:return
  757. 757 :
  758. 758 :
  759. 759 rem ********************************
  760. 760 rem *   verformung ueber joystick  *
  761. 761 rem ********************************
  762. 762 ifwqandei=0thenwq=0:b=3:gosub334
  763. 763 gosub77
  764. 764 ifj=128then767
  765. 765 ifint(j/2)=j/2then763
  766. 766 j=int(j/2)+1:return
  767. 767 b=3:gosub334:c=0
  768. 768 return
  769. 769 ifa<49ora>57thenc=0:sv=0:return
  770. 770 a=a-48:xa=int((9-a)/3)*3:xb=a-int((a-1)/3)*3
  771. 771 xb=3+(xb<2)*2+(xb>2)*1:c=xa+xb:sv=c:wq=1
  772. 772 ei=1:sysl,1:syse,0:gosub55:ifc=10goto775
  773. 773 ifc>6theninput"[147][196]rehwinkel   90[157][157][157][157]";w:goto776
  774. 774 ifc>3theninput"[147][214]erschiebungssummand   50[157][157][157][157]";w:goto776
  775. 775 input"[147][214]erzerrungsfaktor   1.5[157][157][157][157][157]";w:goto776
  776. 776 ifw=0thenc=0:sv=0:ei=0:sysfl,4
  777. 777 return
  778. 778 :
  779. 779 :
  780. 780 rem ********************************
  781. 781 rem *     hauptmenue loeschen      *
  782. 782 rem ********************************
  783. 783 :
  784. 784 gosub56
  785. 785 gosub41
  786. 786 print"         [200]auptmenue '[204]oeschen'         [146] ";
  787. 787 gosub42
  788. 788 print"[193]. [198]laechen durchblaettern"
  789. 789 print"[194]. [205]akros durchblaettern"
  790. 790 print"[195]. [194]ekanntes [205]akro loeschen"
  791. 791 print"[196]. [193]lles loeschen "
  792. 792 print"[197]. [214]erbindungsvorschrift"
  793. 793 gosub81:if(a<65ora>69)anda<>95goto793
  794. 794 ifa=95goto880
  795. 795 ona-64goto802,828,854,866,877
  796. 796 :
  797. 797 :
  798. 798 rem ********************************
  799. 799 rem *    flaechen durchblaettern   *
  800. 800 rem ********************************
  801. 801 :
  802. 802 ifd=1goto793
  803. 803 syse,1:f=1:jl=0:n1=d-1:mo=1
  804. 804 gosub92
  805. 805 ifa=86thensysd2,f:sysc2,usr(1),f,usr(2),vb
  806. 806 ifa=95andjl>0thenpokerf,14:gosub820:gosub56:goto118
  807. 807 ifa=95thensysl,1:gosub56:goto118
  808. 808 gosub446:ifa=133andjl>1thenjl=0:pokerf,14:gosub820:f=f-1:goto804
  809. 809 ifa=94goto814
  810. 810 ifa=76andjl>0thenjl=jl+1:dg=f:sysl,1:gosub254:f=f-1:n1=d-1:goto804
  811. 811 ifa=76goto818
  812. 812 sysfl,4:gosub97:goto805
  813. 813 rem ***** '^' *******************
  814. 814 pokerf,14:sysl,1:b=2:gosub31
  815. 815 gosub56:dg=f:sysg,0,0,42,9,2,3
  816. 816 sysda,2,dg,1,2:sysco,1,0:u=2:goto214
  817. 817 rem *********** 'l' *************
  818. 818 sysl,1:b=2:gosub31:gosub58:dg=f
  819. 819 sysda,2,dg,1,2:syse,2:sysco,1,0:syse,1:gosub254:n1=d-1:goto804
  820. 820 sysl,1:b=2:gosub31:gosub58:sysda,0,d,1,2:syse,2
  821. 821 sysco,1,0:syse,1:return
  822. 822 :
  823. 823 :
  824. 824 rem ********************************
  825. 825 rem *     makros durchblaettern    *
  826. 826 rem ********************************
  827. 827 :
  828. 828 ifk=0goto793
  829. 829 syse,1:f=1:mo=3:n1=k
  830. 830 gosub92
  831. 831 ifa=95thensysl,1:gosub56:goto118
  832. 832 ifa<>86goto836
  833. 833 fori=1tod:sysd2,i:ifusr(2)<>kgoto835
  834. 834 sysc2,usr(1),i,usr(2),vb
  835. 835 nexti:syse,1
  836. 836 ifa=94goto840
  837. 837 ifa=76goto845
  838. 838 sysfl,4:gosub97:goto831
  839. 839 rem ******* '^' *****************
  840. 840 sysl,1:sysco,2,0:syse,2
  841. 841 b$=b$(f):gosub61:as=0:zn=0:gosub58
  842. 842 b=1:gosub31:gosub59:dg=f:sysda,4,dg,1,1:syse,1
  843. 843 as=1:goto515
  844. 844 rem ******* 'l' *****************
  845. 845 sysl,1:sysco,2,0:syse,2:gosub58
  846. 846 b=1:gosub31:sysda,4,f,1,1:syse,1
  847. 847 dg=f:gosub268:k=k-1:n1=k:goto118
  848. 848 :
  849. 849 :
  850. 850 rem ********************************
  851. 851 rem *   bekanntes makro loeschen   *
  852. 852 rem ********************************
  853. 853 :
  854. 854 ifk=0goto793
  855. 855 gosub41:gosub43
  856. 856 print"   [205]akro mit bekanntem [206]amen loeschen  [146] ":gosub44
  857. 857 ifn1goto785
  858. 858 gosub49:ifn1thenf=n1:mo=3:n1=k:goto830
  859. 859 syse,1:gosub56:goto118
  860. 860 :
  861. 861 :
  862. 862 rem ********************************
  863. 863 rem *     alles loeschen           *
  864. 864 rem ********************************
  865. 865 :
  866. 866 print"[211]ind [211]ie sicher ?[146]  ";
  867. 867 gosub47
  868. 868 printa$:ifa$<>"j"goto870
  869. 869 sys25919:clr:d=1:goto12
  870. 870 gosub56:syse,1:goto118
  871. 871 :
  872. 872 :
  873. 873 rem ********************************
  874. 874 rem *     verbindungsvorschrift    *
  875. 875 rem ********************************
  876. 876 :
  877. 877 i=1:gosub41:gosub43
  878. 878 print"    [205]omentane  [214]erbindungsvorschrift   [146] "
  879. 879 gosub84
  880. 880 syse,1:gosub56:goto118
  881. 881 :
  882. 882 :
  883. 883 rem ********************************
  884. 884 rem *    mehr als 63 makros ?      *
  885. 885 rem ********************************
  886. 886 :
  887. 887 sysl,1:i=1:syse,0:gosub55:gosub41
  888. 888 print"[147]":gosub84
  889. 889 sysfl,4:return
  890. 890 ifk<64andmm<64thenreturn
  891. 891 fori=1tod:sysd2,i:gosub74:ifsa<>0thensa=sa-1
  892. 892 sysc2,xa,i,sa,vb:next:fori=2tomm:b$(i-1)=b$(i):next:mm=mm-1:k=k-1:return
  893. 893 :
  894. 894 :
  895. 895 rem ********************************
  896. 896 rem *    parameter codieren        *
  897. 897 rem *********************************
  898. 898 gosub718:ifa$="_"thensyse,1:pokerf,14:goto118
  899. 899 a=49153:pokea+919,255:i=900:w=k:gosub717:w=d:gosub717:w=v:gosub717
  900. 900 gosub726:poke836,0:print"[155][147]load"chr$(34)"cad.main"chr$(34)",8"
  901. 901 print"run:":poke631,19:poke632,13:poke633,13:poke198,3:new
  902. 902 :
  903. 903 :
  904. 904 rem ********************************
  905. 905 rem *    parameter decodieren      *
  906. 906 rem ********************************
  907. 907 a=49153:k=peek(a+900)+256*peek(a+901):d=peek(a+902)+256*peek(a+903)
  908. 908 v=peek(a+904)+256*peek(a+905):gosub723:return
  909. 909 :
  910. 910 :
  911. 911 rem ********************************
  912. 912 rem *   zu viele daten ?           *
  913. 913 rem ********************************
  914. 914 :
  915. 915 ifv+ze<1320thenf=0:return
  916. 916 f=1:sysl,1:syse,0:gosub55:print"[147]    [198]uer diese [207]peration reicht der "
  917. 917 print"     [211]peicherplatz nicht mehr aus!":gosub47:return
  918. 918 ze=0:fori=1tod-1:sysd2,i:sr=usr(1)
  919. 919 ifusr(2)=dhthensysd2,i+1:ze=ze+usr(1)-sr
  920. 920 nexti:return
  921.